Spatial Analysis

Methods

Spatial data preparation

Load data

Maps data

We use three different shapefiles for the continental U.S. land mass, the State waters of maine, new hampshire, massachusets, connecticut, rhode island, new york, new jersey, delaware, maryland, virginia, north carolina and the North East EEZ.

1.- Land shapefile; covers the US land territory for visualization. Data provided from the map package.

2.- State waters; covers the state waters of the NE US states. Data from data.gov.

License: No license information was provided. If this work was prepared by an officer or employee of the United States government as part of that person’s official duties it is considered a U.S. Government Work.

3.- EEZ shapefile; Used the Sea Around Us shapefle updated to June 2016.

Create base shapefile for computation

As a first step we need to divide the NE US EEZ among the different states. For that we expanded state waters up to the 200 nautical miles to then estimate the percentage that each expanded-state-waters occupied. Note that in all cases these areas overlapped and percentages accounted for it. We did this by following these steps:

• 1. Expand state waters using a buffer
• 2. Grid that buffer on a 0.3 resolution
• 3. Crop the buffer to the EEZ

1. Expand Spatial regions (a.k.a buffers)

We set a buffer of 410000 m (410 km, ~ 221 nm) that overshoots the EEZ a bit, but is eventually cropped

2. Expand grid within buffer

Here we expand a grid within the buffer so we can estimate the proportion of each state.

Note: Dark grey shaded area is the grid

2.1 Merge grid and buffers

Once we have a gridded area, we converted the grid to a sf so we can merge it with the buffered states and finally filter out everything outside the states polygon

3. Crop buffers to EEZ

Finally, we crop the grided buffers to within the EEZ to capture the actual water space.

Note: This step takes quite a while because of the size of the EEZ shapefile. No, you cannot use st_simplify() here

3.1 Paper figure; buffer plot

plot_data <-grid_eez_sf %>% 
    mutate(state = str_to_sentence(state)) %>% 
    left_join(state_lat)

p <- gridExtra::grid.arrange(
  # Overall (overlapping) position
  ggplot(plot_data) +
    geom_sf(data = eez_sf, aes(), fill = "white") + 
    geom_sf(aes(color = order, fill = order), alpha = 0.3) +
    geom_sf(data = land_sf, aes()) +
    geom_sf_label_repel(data = land_sf, aes(label= abrev), 
                      size = 2,
                      box.padding = 0.10,
                      hjust = 1) +
    scale_color_manual(values = state_pallet) +
    scale_fill_manual(values = state_pallet) +
    my_ggtheme_p(leg_pos = "",
                 ax_tx_s = 12) +
    coord_sf(ylim = c(30,48)) +
    scale_y_continuous(breaks = c(30,35,40,45))+
    labs(x = "", y = ""),
  # Showing each state separately
  
    ggplot(plot_data) +
    geom_sf(data = land_sf, aes(), fill = "grey80") +
    geom_sf( aes(color = order),size = 0.1, alpha = 0.8) +
    facet_wrap(~ state) +
    theme(legend.position = "top") +
    scale_color_manual(values = state_pallet,
                       labels = plot_data %>% arrange(order) %>%  pull(state) %>% unique()) +
    my_ggtheme_p(leg_pos = "",
                 ax_tx_s = 6,
                 axx_tx_ang = 45,
                 hjust = 1
                 ),
  nrow = 1,
  bottom = "Longitude",
  left = "Latitude")


  ggsave(filename = "buffer_figure.jpg",
         plot = p,
         path = my_path("R","Figures"),
         width = 10,
         height = 5
         )

Buffer figure for paper

Interpolation rutine

In this step we interpolate the survey data within the previously created grid following a Triangular Irregular Surface method.

• We removed cases where wtcpue < 0

Functions needed

We need to create a couple of functions to run the whole process

Interpolation main fx (tis).

This is the main function used to interpolate the data per year. It follows a Triangular Irregular Surface method using the interp::interp() function. If you want to see the function clic on code

tis <- function(input_data, grid, yr, taxa, reg){
  
  # --------------- #
  # Testing
  # print(paste(yr))
  # yr = 1976
  # --------------- #
  
  # Filter data
  data <- input_data %>% 
    filter(year == yr,
           spp == taxa,
           region == reg
    ) %>% 
    # Average duplicated hauls in the same spot
    group_by(region,year,spp,lat,lon) %>%
    summarise_at(vars(wtcpue),
                 mean,na.rm = T)
    
  # Only interpolate cases where there is more than 3 rows
  # Marked by the function 
    if(nrow(data) <= 3){
      fit_tin <- tibble()
    }else{
      
      # Triangular Irregular Surface
      fit_tin <- interp::interp( # using {interp}
        x = data$lon,           # the function actually accepts coordinate vectors
        y = data$lat,
        z = data$wtcpue,
        xo = grid$lon,     # here we already define the target grid
        yo = grid$lat,
        output = "points"
      ) %>% 
        bind_cols() %>% 
        bind_cols(grid) %>%
        mutate(year = yr,
               region = reg,
               spp = taxa) %>% 
        select(index, state, year, region, spp, lon=x, lat=y, value = z)
      
    }
   
    return(fit_tin)
}

# Test me
# Needs variables in Control panel
# Test no data: "Alosa aestivalis", reg = "Northeast US Fall", yr = 1974 
# tis(input_data = ocean_data, grid = grid_eez_df, taxa = "Illex illecebrosus", reg = "Northeast US Fall", yr = 1973)



# lapply(years,tis,input_data = ocean_data, grid = grid_eez_df, taxa = "Illex illecebrosus", reg = regions[2])

Run function

This is a sub-function that runs the tis() function by taxa and region. It saves the output as a .csv file for each species.

run_tis <- function(input_data, grid, years, taxa, reg){
  
  
  # Run tis for species and surveys
  for(r in 1:2){
    
    partial_df <- bind_rows(
      lapply(years,tis,input_data = ocean_data, grid = grid_eez_df, taxa = taxa, reg = regions[r])
    )
    
    if(r == 1){
      historic_tif <- partial_df
    }else{
      historic_tif <- bind_rows(historic_tif,partial_df)
    }
    
  }
  
  # ----------------------- #
  # Save dataset per species
  # ----------------------- #
  
  # Set file name
  name <- paste0("tif_",str_replace(taxa," ","_"),".csv")
  
  # Set path name
  save_path <- my_path("R","Partial/Interpolation")
  
  # Set complete path
  save_name <- paste0(save_path,name)
  
  # Create folder if it does not exist
  if(file.exists(save_path) == F){
    dir.create(save_path)
  }
  
  #  Save file
  write_csv(historic_tif,save_name)
  
  return_msg <- paste("Interpolation done for", taxa)
  
  return(return_msg)
  
  
}

# Test me
    # run_tis(input_data = ocean_data, grid = grid_eez_df, taxa = "Centropristis striata", years = years, reg = regions)

Survey data

The interpolation was done with NOAA Northeast Fisheries Science Center Spring and Fall Bottom Trawl Surveys data provided by Ocean adapt. Data was accessed trough the Github.

In primary publications using data from the database, please cite Pinsky et al. 2013. Marine taxa track local climate velocities. Science 341: 1239-1242 doi: 10.1126/science.1239352, as well as the original data sources.

• Using only the Northeast US Fall and Spring bottom trawl survey data for now

Splitting up data

• No part on spatial analysis. Can be ignored.

This is just a sub-step to split up the data into single species files. This makes the app faster as it only needs to load species specific data, rather than all the data at de beginning.

Control Pannel

This is where we load the required data and prepare to run the interpolation function. Note that some of the data here has been previously created

# Load grid df
grid_eez_df <- my_path("D","Spatial","grid_eez_df.csv", read = T)

# Run interpolation for all years
years <- seq(1973,2019,1)

# regions
regions <- c("Northeast US Fall" , "Northeast US Spring")

# species list
spp <- ocean_data %>% 
  filter(region %in% regions,
         spp != "NA") %>% 
  pull(spp) %>% 
  unique()


# Double check runs

spp_runs <- tibble(taxa = (list.files(my_path("R","Partial/Interpolation")))) %>%
  mutate(
    taxa = str_remove(taxa, "tif_"),
    taxa = str_remove(taxa, ".csv"),
    taxa = str_replace(taxa, "_", " ")
  ) 

# Missing runs
spp <- tibble(taxa=spp) %>% 
  anti_join(spp_runs) %>% 
  pull(taxa)

Run routine

Here we just run the routine for each of the species present in the Northeast US Fall and Spring surveys between 1973 and 2019.

• Note there are 43 identified taxa
• Some taxa do not have presence data in some years

# single species run
# run_tis(input_data = ocean_data,
#         grid = grid_eez_df,
#         years = years,
#         reg = regions,
#         taxa = "Illex illecebrosus"
# )


# Run them all in parallel
lapply(spp,
                   run_tis, 
                   input_data = ocean_data,
                   grid = grid_eez_df,
                   years = years,
                   reg = regions
)

Results

Results are now for eight species managed under Mid-Atlantic Council Management Plans according to NOAA.

Scomber scombrus, Peprilus triacanthus (butterfish), Illex illecebrosus (shortfin squid), Paralichthys dentatus (summer flounder), Stenotomus chrysops (Scoop), Centropristis striata (black sea bass), Pomatomus saltatrix (Bluefish), Lopholatilus chamaeleonticeps (Golden tilefish), Caulolatilus microps (blueline tilefish) and Clupea harengus

unique(historic_spp$spp)

[1] "Centropristis striata" "Paralichthys dentatus" "Stenotomus chrysops"  

Average proportion

This map shows the aggregated extrapolated value from all three species per State average across the whole study period within each State’s water.

Note: This is intended to be a supplemental figure

Proportion Change

Here we show the average proportion of the interpolation by State and time period. Time periods were arbitrary defined as;

• Early; 1973 to 1984
• Mid; 1985 to 1997
• Late; 1998 to 2011
• Now; 2012 to 2019

Notes: Figure represents the Spring survey. This computation considers the Overlapping of state waters.

Dynamic figure: Aggregated Proportional change per survey

Paper figure; Per species maps

total_fited <- historic_spp %>% 
  group_by(year,region,spp) %>% 
  summarise(total_value = sum(value,na.rm=T),.groups = "drop")


state_fit <- historic_spp %>% 
  group_by(state,year,region,spp) %>% 
  summarise(state_value = sum(value,na.rm= T), .groups = "drop") %>% 
  left_join(total_fited,
            by = c("year","region","spp")) %>%
  mutate(percentage = state_value/total_value*100) %>% 
  left_join(periods,
            by = "year") %>% 
  group_by(state,order,label,region,spp) %>% 
  summarise(mean_per = round(mean(percentage)),.groups = "drop") %>% 
  #Only show results for spring
  filter(str_detect(region,"Spring")) %>% 
  mutate(spp = gsub(" ","\n",spp))

# The plot
map_plot <- land_sf %>% 
  left_join(state_fit,
            by = "state") %>% 
  ggplot() +
  geom_sf(aes(fill = mean_per)) +
  viridis::scale_fill_viridis("Average proportion per State", alpha = 0.8) +
  facet_grid(spp ~ label) +
  labs(x = "Longitude", 
       y = "Latitude") +
  my_ggtheme_p(facet_tx_s = 20,
               leg_pos = "bottom",
               axx_tx_ang = 45,
               ax_tx_s = 12,
               ax_tl_s = 18,
               hjust = 1) +
  theme(legend.key.width = unit(4,"line")) 


  ggsave(filename = "proportion_chg_spp.jpg",
         plot = map_plot,
         path = my_path("R","Figures"),
         width = 14,
         height = 14
         )

Proportion change per species map for paper

Paper figure: Aggregated Proportional change

Proportion change aggregated all species map for paper

Area plot

This graph shows the proportion of the interpolation value each State has over time.

Note: This plot is interactive. For ease comparison between States you can;

• One click on any State to remove it from the plot
• Two clicks on any State to isolate it from the plot (other states can then be added by just clicking on them).
• The bottom panel allows you to reduce the time frame

Dynamic aggregated plot

total_fited <- historic_spp %>% 
  group_by(year,region) %>% 
  summarise(total_value = sum(value,na.rm=T),.groups = "drop")

# group by state
state_fit <- historic_spp %>% 
  group_by(state,year,region) %>% 
  summarise(state_value = sum(value,na.rm= T), .groups = "drop") %>% 
  left_join(total_fited,
            by = c("year","region")) %>%
  mutate(percentage = state_value/total_value*100)

# Plot me
p <- ggplot(state_fit) +
  geom_area(
    aes(
      x = year,
      y = round(percentage),
      fill = state
    )
  ) +
  ylab("Percentage (%)") +
  # viridis::scale_fill_viridis(discrete = T, alpha = 0.8) +
  scale_fill_manual(values = state_pallet) +
  MyFunctions::my_ggtheme_p() +
  facet_wrap(~region, ncol = 1) +
  theme_dark()

ggplotly(p,
         dynamicTicks = TRUE) %>% 
  layout(hovermode = "x") %>%
  rangeslider()

NA

Area plot (running mean)

This graph shows the proportion of each State smoothed over a *10 years running mean**. It allows to better see increasing and decreasing trends.

Dynamic aggregated plot

Note: This plot is also interactive and thus, follows the same options of the previous one.

# group by state
state_fit <- historic_spp %>% 
  group_by(state,year,region,.groups = "drop") %>% 
  summarise(state_value = sum(value,na.rm= T), .groups = "drop") %>% 
  left_join(total_fited,
            by = c("year","region")) %>%
  mutate(percentage = state_value/total_value*100) %>% 
  group_by(state,region) %>% 
  mutate(RMean = zoo::rollmean(x = percentage, 
                            10,
                            fill = NA,
                            na.rm=T)
    ) %>%  
  left_join(state_lat)

Joining, by = "state"

# Plot me
p <- ggplot(state_fit) +
  geom_area(
    aes(
      x = year,
      y = round(RMean),
      fill = state
      # fill = order
    )
  ) +
  ylab("10 yrs running average (%)") +
  scale_fill_manual(
    "State",
    values = state_pallet,
    # labels = state_fit %>% arrange(order) %>%  pull(state) %>% unique()
  ) +
  MyFunctions::my_ggtheme_p() +
  facet_wrap(~region, ncol = 1) +
  theme_dark()

suppressWarnings(
ggplotly(p,
         dynamicTicks = TRUE) %>% 
  layout(hovermode = "x") %>% 
  # add_trace() %>% 
  rangeslider()
)

NA

Paper figure: Aggregated Proportional change

Proportion change aggregated all species map for paper

Paper figure: Per Species Proportional change

Proportion change aggregated all species map for paper

Historic quota Vs distributions

This section of the results explores the differences between the historic distribution of te stock and the historic quota allocation. We collected the proportion of the total quota that each State gets for each species.

Right now the analysis only covers black sea bass, summer flounder and scup. But we can go speceis by species to see which ones have their quota allocated by state to include them in the analysis.

• Black Sea Bass; Centropristis striata

Note: We are using the new allocations based on the stock’s most recent biomass distribution*

• Summer flounder

• Scup Summer period

For State-level managed species see the Atlantic States Marine Fisheries Comission website and go species-by-species.

quota_allocation <- state_lat %>% 
  mutate(
    "Centropristis striata" = c(
      0.0040, #ME
      0.0040, #NH
      0.1564, #MA
      0.1323, #RI
      0.0367, #CT
      0.0857, #NY
      0.2010, #NJ
      0.0411, #DE
      0.0888, #MD
      0.1614, #VA
      0.0888 #NC
    ),
    "Paralichthys dentatus" = c(
      0.0004756, #ME 
      0.0000046, #NH 
      0.0682046, #MA 
      0.1568298, #RI 
      0.0225708, #CT 
      0.0764699, #NY 
      0.1672499, #NJ 
      0.0001779, #DE 
      0.0203910, #MD
      0.2131676, #VA
      0.2744584 #NC
    ),
    "Stenotomus chrysops" = c(
      0.0012101, #ME
      0.0000000, #HN
      0.2158729, #MA
      0.5619456, #RI
      0.0315399, #CT
      0.1582466, #NY
      0.0291667, #NJ
      0.0000000, #DE
      0.0001190, #MD
      0.0016502, #VA
      0.0002490 #NC
    )
  ) %>% 
  gather("spp","quota",4:6)

# Double check they all add to 1...
quota_allocation %>% 
  group_by(spp) %>% 
  summarise_at(vars(quota),sum)

quota_allocation %>% 
  arrange(order) %>% 
  select(-order) %>% 
  spread(spp,quota) %>% 
  kable()

state	abrev	Centropristis striata	Paralichthys dentatus	Stenotomus chrysops
Connecticut	CT	0.0367	0.0225708	0.0315399
Delaware	DE	0.0411	0.0001779	0.0000000
Maine	ME	0.0040	0.0004756	0.0012101
Maryland	MD	0.0888	0.0203910	0.0001190
Massachusetts	MA	0.1564	0.0682046	0.2158729
New hampshire	NH	0.0040	0.0000046	0.0000000
New jersey	NJ	0.2010	0.1672499	0.0291667
New york	NY	0.0857	0.0764699	0.1582466
North carolina	NC	0.0888	0.2744584	0.0002490
Rhode island	RI	0.1323	0.1568298	0.5619456
Virginia	VA	0.1614	0.2131676	0.0016502

Get data ready

state	abrev	year	region	spp	quota	state_value	total_value	Distribution	Historic	RMean	order
Connecticut	CT	1976	Northeast US Spring	Centropristis striata	0.0367000	15.1325552	466.4871	3.2439387	3.67000	6.403059	e
Connecticut	CT	1976	Northeast US Spring	Paralichthys dentatus	0.0225708	82.6630292	712.1242	11.6079505	2.25708	11.297168	e
Connecticut	CT	1976	Northeast US Spring	Stenotomus chrysops	0.0315399	83.6256570	676.5664	12.3603025	3.15399	9.987846	e
Connecticut	CT	1978	Northeast US Spring	Centropristis striata	0.0367000	14.1686584	1262.1908	1.1225449	3.67000	6.056662	e
Connecticut	CT	1978	Northeast US Spring	Paralichthys dentatus	0.0225708	68.1083517	784.0304	8.6869531	2.25708	11.627109	e
Connecticut	CT	1978	Northeast US Spring	Stenotomus chrysops	0.0315399	0.4335304	2990.5258	0.0144968	3.15399	10.406455	e

Exploring different ways to show the results

Difference line plot

This version shows the difference between the Historic quota allocation and the distribution proportion of the stock:

• diff < 0 = the distribution proportion is larger than the allocated quota
• diff > 0 = the distribution proportion is smaller than the allocated quota

Linetype plot

Here, we plot the distributional quota (solid lines) with each State’s allocation with dashed (—-) lines

# Option one

quota_df %>% 
  gather("level","quota",Distribution:RMean) %>% 
  # mutate(diff = quota_per- percentage) %>% 
  # View()
  ggplot() +
  geom_line(
    aes(
      x = year,
      y = quota,
      color = order
    )
  ) +
  labs(x = "Year",y = "Quota (%)") +
  scale_fill_manual("State",
    values = state_pallet,
    labels = quota_df %>% arrange(order) %>%  pull(state) %>% unique()
    ) +
  scale_color_manual("State",
    values = state_pallet,
    labels = quota_df %>% arrange(order) %>%  pull(state) %>% unique()
    ) +
  scale_linetype("Quota") +
  facet_grid(spp ~ level)+
  theme_dark()

Efficiency index

The idea here is create and efficiency index (Danger!) that computes the alignment between the distribution and the actual allocation. The index is simply;

\[ei = \frac{HistoricQuota}{DistributionProportion}\] So, in cases where ei = 1, the quota is aligned with the distribution; when ei > 1 then the historic quota is more than the stock’s State’s distribution, contrarily, ei < 1 means that the historic quota is less than what the State currently has.

Note: - There are some crazzy outliers that have been removed, for now… - Bottom plot representing index as a Rmean

As a normal year to year